home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / mbase1.zip / MBDEMO.PRG < prev    next >
Text File  |  1992-12-17  |  13KB  |  560 lines
  1. *:*********************************************************************
  2. *:
  3. *:        Program: MBDEMO.PRG
  4. *:
  5. *:         System: MAILbase Program
  6. *:         Author: Thomas D. Stubbs
  7. *:      Copyright (c) 1992 MAILbase
  8. *:  Last modified: 12/17/92     13:00
  9. *:
  10. *:  Screen functions used in this demo courtesy
  11. *:  Jeff B. Davis, Davis Consulting
  12. *:
  13. *:
  14. *:*********************************************************************
  15. SET SCOREBOARD OFF
  16. SET Cursor OFF
  17. SET MESSAGE TO 20 CENTER
  18.  
  19. SET COLOR TO N/W,GR+/B
  20. @  0,0 CLEAR TO  0,79
  21. @  0,1 SAY 'Mbase v2.60 (c) Copyright 1992 MAILbase'
  22. SET COLOR TO W+/B
  23.  
  24. fillscrn(1,0,23,79,'░')
  25.  
  26. SET COLOR TO N/W
  27. @ 24,0 CLEAR TO 24,79
  28. @ 24,1 SAY 'Enter=Select Option │ ESC=Exit │ '
  29.  
  30. MAINSCRN=SAVESCREEN(0,0,24,79)
  31. MAIN_OP=1
  32. CITY=SPACE(28)
  33. ZIP=SPACE(5)
  34. STATE='  '
  35. STATENM=SPACE(40)
  36.  
  37. DO WHILE .T.
  38.  
  39.  MKWINDOW(4,28,12,51,'D')
  40.  MKWINDOW(19,22,21,57)
  41.  
  42.  @  6,31 PROMPT " CITY  -> ZIP   "  MESSAGE "List Zip Codes for a City"
  43.  @  7,31 PROMPT " ZIP   -> CITY  "  MESSAGE "List City Names for a Zip Code"
  44.  @  8,31 PROMPT " ZIP   -> STATE "  MESSAGE "Return State for a Zip Code"
  45.  @  9,31 PROMPT " STATE -> ABBR  "  MESSAGE "Return State Abbreviation"
  46.  @ 10,31 PROMPT " ABBR  -> STATE "  MESSAGE "Return Fullname for Abbr."
  47.  
  48.  MENU TO MAIN_OP
  49.  
  50.  RESTSCREEN(0,0,24,79,MAINSCRN)
  51.  
  52.  DO CASE
  53.   CASE LASTKEY()=27
  54.    EXIT
  55.  
  56.   CASE LASTKEY()=28
  57.  
  58.   CASE MAIN_OP=1
  59.    DO DEMO1
  60.  
  61.   CASE MAIN_OP=2
  62.    DO DEMO2
  63.  
  64.   CASE MAIN_OP=3
  65.    DO DEMO3
  66.  
  67.   CASE MAIN_OP=4
  68.    DO DEMO4
  69.  
  70.   CASE MAIN_OP=5
  71.    DO DEMO5
  72.  
  73.  ENDCASE
  74.  
  75.  RESTSCREEN(0,0,24,79,MAINSCRN)
  76.  
  77. ENDDO
  78.  
  79. SET COLOR TO N/W
  80. MkWindow(  5,  7, 13, 73)
  81. @  6,28 say "Thank You for using the:"
  82. @  8,25 say "MAILbase Library for Clipper Demo"
  83. @  9,20 say "(c) '1992 MAILbase.  All rights reserved."
  84. @ 10,27 say "Written by Thomas D. Stubbs"
  85. @ 12,24 say "Mail your order for $95.00 today!"
  86.  
  87. Tone( 300, .1 )
  88.  
  89. Inkey(0)
  90.  
  91. Set Color to
  92. Clear
  93.  
  94. Set Color to n/w
  95. @  0,  0
  96. @  0, 11 say "Mbase v2.60 (c)1992 MAILbase.   All rights reserved"
  97.  
  98. Set Color to
  99. @  2,  0 Say ""
  100.  
  101. Set Curs ON
  102. CloseMbase()
  103. Clear ALL
  104.  
  105. Quit
  106.  
  107. *****************************
  108. PROCEDURE DEMO1
  109.  
  110.  WINDOW1=MKWINDOW(9,15,13,65)
  111.  @ 10,18 SAY "Enter a City Name:" GET CITY PICTURE "@K"
  112.  @ 12,18 SAY "Enter a State abbreviation:" GET STATE PICTURE "@K!!" VALID (IsState(STATE) .OR. EMPTY(STATE))
  113.  @ 12,COL()+1 SAY "(optional)"
  114.  SET CURSOR ON
  115.  READ
  116.  SET CURSOR OFF
  117.  KLWINDOW(WINDOW1)
  118.  
  119.  IF LASTKEY()=27
  120.   RETURN
  121.  ENDIF
  122.  
  123.  DECLARE ZIPS[1000],CTYPE[1000],ZTYPE[1000]
  124.  RET_VAL=City2Zip(CITY,ZIPS,CTYPE,ZTYPE,STATE)
  125.  
  126.  DO CASE
  127.   CASE RET_VAL>0
  128.    CITY_STR=ALLTRIM(CITY)+IIF(!EMPTY(STATE),", "+STATE,"")
  129.  
  130.    WINDOW1=MKWINDOW(2,10,5,46)
  131.    @ 3,17 SAY "There are "+LTRIM(STR(RET_VAL,3,0))+" zips for:"
  132.    oldCOLOR=SETCOLOR("B/W")
  133.    @ 4,26-LEN(CITY_STR)/2 SAY CITY_STR
  134.    SETCOLOR(oldCOLOR)
  135.  
  136.    DECLARE ZT[4],ZTC[4]
  137.    ZT[1]="g"
  138.    ZT[2]="p"
  139.    ZT[3]="u"
  140.    ZT[4]="a"
  141.  
  142.    ZTC[1]=0
  143.    ZTC[2]=0
  144.    ZTC[3]=0
  145.    ZTC[4]=0
  146.  
  147.    FOR X=1 TO RET_VAL
  148.     ZIPS[X]=' '+ZIPS[X]+" │ "+ZT[ZTYPE[X]]+"│"+IIF(CTYPE[X]<32,STR(CTYPE[X],2,0)," *")
  149.     ZTC[ZTYPE[X]]=ZTC[ZTYPE[X]]+1
  150.    NEXT
  151.  
  152.    WINDOW2=MKWINDOW(8,10,14,46)
  153.    @ 8,18  SAY "Zip type count"
  154.    @ 10,16 SAY "(g) General Zip...."+STR(ZTC[1],3,0)
  155.    @ 11,16 SAY "(p) PO Box Only...."+STR(ZTC[2],3,0)
  156.    @ 12,16 SAY "(u) Unique Zip....."+STR(ZTC[3],3,0)
  157.    @ 13,16 SAY "(a) APO/FPO........"+STR(ZTC[4],3,0)
  158.  
  159.    WINDOW3=MKWINDOW(17,10,21,46)
  160.    @ 18,15 SAY "Press Enter on an element"
  161.    @ 19,15 SAY "to see alternate names if"
  162.    @ 20,15 SAY "available (type>1)"
  163.  
  164.    WINDOW4=MKWINDOW(2,57,IIF(RET_VAL>16,20,5+RET_VAL),71)
  165.  
  166.    @ 2,57 SAY "┌───────┬──┬──┐"
  167.    @ 3,57 SAY "│  ZIP  │ZT│CT│"
  168.    @ 4,57 SAY "├───────┼──┼──┤"
  169.  
  170.    @ 24,45 SAY "│ZT=Zip Type Code│CT=City Type Code│"
  171.  
  172.    ACHOICE(5,58,IIF(RET_VAL>14,19,5+RET_VAL),70,ZIPS,.T.,"LOOKUP1")
  173.  
  174.   CASE RET_VAL=0
  175.    TONE(300,1)
  176.    TONE(300,1)
  177.    TONE(300,1)
  178.    WINDOW3=MKWINDOW(17,10,21,46)
  179.    @ 18,15 SAY "There were no cities names"
  180.    @ 19,15 SAY "found matching your input "
  181.    @ 20,15 SAY "    (press any key)"
  182.    INKEY(0)
  183.  
  184.   CASE RET_VAL<0
  185.    WINDOW3=MKWINDOW(17,10,21,46)
  186.    @ 18,13 SAY "An error occurred during search"
  187.    @ 19,18 SAY "Error # was "+STR(MbaseErr(),2,0)
  188.    @ 20,15 SAY "    (press any key)"
  189.    INKEY(0)
  190.  
  191.  ENDCASE
  192.  
  193. RETURN
  194.  
  195. *****************************
  196. PROCEDURE DEMO2
  197.  
  198.  WINDOW1=MKWINDOW(9,30,13,50)
  199.  @ 10,32 SAY "Enter a Zip Code:"
  200.  @ 11,38 GET ZIP
  201.  SET CURSOR ON
  202.  READ
  203.  SET CURSOR OFF
  204.  KLWINDOW(WINDOW1)
  205.  
  206.  IF LASTKEY()=27
  207.   RETURN
  208.  ENDIF
  209.  
  210.  DECLARE CITIES[30],ZTYPE[30]
  211.  RET_VAL=Zip2City(ZIP,CITIES,ZTYPE)
  212.  
  213.  DO CASE
  214.   CASE RET_VAL>0
  215.  
  216.    WINDOW1=MKWINDOW(2,5,5,31)
  217.    @ 3,7 SAY "There are "+LTRIM(STR(RET_VAL,2,0))+" cities for:"
  218.    oldCOLOR=SETCOLOR("B/W")
  219.    @ 4,15 SAY ZIP
  220.    SETCOLOR(oldCOLOR)
  221.  
  222.    DECLARE ZT[4],ZTC[4]
  223.    ZT[1]="g"
  224.    ZT[2]="p"
  225.    ZT[3]="u"
  226.    ZT[4]="a"
  227.  
  228.    ZTC[1]=0
  229.    ZTC[2]=0
  230.    ZTC[3]=0
  231.    ZTC[4]=0
  232.  
  233.    FOR X=1 TO RET_VAL
  234.     CITIES[X]=' '+LEFT(CITIES[X]+SPACE(28),28)+"│ "+ZT[ZTYPE[X]]
  235.     ZTC[ZTYPE[X]]=ZTC[ZTYPE[X]]+1
  236.    NEXT
  237.  
  238.    WINDOW2=MKWINDOW(8,5,14,31)
  239.    @ 8,11 SAY "Zip type count"
  240.    @ 10,7 SAY "(g) General Zip..."+STR(ZTC[1],2,0)
  241.    @ 11,7 SAY "(p) PO Box Only..."+STR(ZTC[2],2,0)
  242.    @ 12,7 SAY "(u) Unique Zip...."+STR(ZTC[3],2,0)
  243.    @ 13,7 SAY "(a) APO/FPO......."+STR(ZTC[4],2,0)
  244.  
  245.    WINDOW3=MKWINDOW(17,5,21,31)
  246.    @ 18,7 SAY "Press Enter on a city"
  247.    @ 19,7 SAY "name to see city type"
  248.    @ 20,7 SAY "code for this zip..."
  249.  
  250.    WINDOW4=MKWINDOW(2,39,IIF(RET_VAL>16,20,5+RET_VAL),72)
  251.  
  252.    @ 2,39 SAY "┌─────────────────────────────┬──┐"
  253.    @ 3,39 SAY "│  City Name                  │ZT│"
  254.    @ 4,39 SAY "├─────────────────────────────┼──┤"
  255.  
  256.    @ 24,55 SAY "│ZT=Zip Type Code│"
  257.  
  258.    ACHOICE(5,40,IIF(RET_VAL>14,19,5+RET_VAL),71,CITIES,.T.,"LOOKUP2")
  259.  
  260.   CASE RET_VAL=0
  261.    TONE(300,1)
  262.    TONE(300,1)
  263.    TONE(300,1)
  264.    WINDOW3=MKWINDOW(17,5,21,31)
  265.    @ 18,7 SAY "This zip code has not"
  266.    @ 19,7 SAY "been assigned by USPS"
  267.    @ 20,7 SAY "  (press any key)"
  268.    INKEY(0)
  269.  
  270.   CASE RET_VAL<0
  271.    WINDOW3=MKWINDOW(17,5,21,31)
  272.    @ 18,7 SAY "An error occurred during"
  273.    @ 19,7 SAY "search.  Error # was "+STR(MbaseErr(),2,0)
  274.    @ 20,7 SAY "  (press any key)"
  275.    INKEY(0)
  276.  
  277.  ENDCASE
  278.  
  279. RETURN
  280.  
  281. *************************
  282. PROCEDURE DEMO3
  283.  
  284.  WINDOW1=MKWINDOW(9,20,15,60)
  285.  @ 10,32 SAY "Enter a Zip Code:"
  286.  @ 11,38 GET ZIP
  287.  SET CURSOR ON
  288.  READ
  289.  SET CURSOR OFF
  290.  
  291.  IF LASTKEY()=27
  292.   RETURN
  293.  ENDIF
  294.  
  295.  @ 13,33 SAY "State is:  "
  296.  oldCOLOR=SETCOLOR("B/W")
  297.  STATEA=Zip2State(ZIP)
  298.  STATEN=StateName(STATEA)
  299.  @ ROW(),COL() SAY STATEA
  300.  @ ROW()+1,40-LEN(STATEN)/2 SAY STATEN
  301.  SETCOLOR(oldCOLOR)
  302.  INKEY(0)
  303.  KLWINDOW(WINDOW1)
  304.  
  305. RETURN
  306.  
  307. ****************************
  308. PROCEDURE DEMO4
  309.  
  310.  WINDOW1=MKWINDOW(9,18,15,62)
  311.  @ 10,29 SAY "Enter a Full State Name:"
  312.  @ 11,20 GET STATENM PICTURE "@K"
  313.  SET CURSOR ON
  314.  READ
  315.  SET CURSOR OFF
  316.  
  317.  IF LASTKEY()=27
  318.   RETURN
  319.  ENDIF
  320.  
  321.  STATEA=StateAbbr(STATENM)
  322.  
  323.  IF LEN(STATEA)<2
  324.   @ 13,28 SAY "State name was not found"
  325.  ELSE
  326.   @ 13,28 SAY "State abbreviation is: "
  327.   oldCOLOR=SETCOLOR("B/W")
  328.   @ 13,COL() SAY STATEA
  329.   SETCOLOR(oldCOLOR)
  330.  ENDIF
  331.  INKEY(0)
  332.  KLWINDOW(WINDOW1)
  333.  
  334. RETURN
  335.  
  336. ****************************
  337. PROCEDURE DEMO5
  338.  
  339.  WINDOW1=MKWINDOW(9,20,14,60)
  340.  @ 10,23 SAY "Enter a State abbreviation:" GET STATE VALID (IsState(STATE) .OR. EMPTY(STATE))
  341.  SET CURSOR ON
  342.  READ
  343.  SET CURSOR OFF
  344.  
  345.  IF LASTKEY()=27
  346.   RETURN
  347.  ENDIF
  348.  
  349.  STATEN=StateName(STATE)
  350.  
  351.  oldCOLOR=SETCOLOR("B/W")
  352.  @ 12,40-LEN(STATEN)/2 SAY STATEN
  353.  SETCOLOR(oldCOLOR)
  354.  INKEY(0)
  355.  KLWINDOW(WINDOW1)
  356.  
  357. RETURN
  358.  
  359. ****************************
  360. FUNCTION LOOKUP1
  361.  PARAMETER Stat_Msg, Element, Rel_Pos
  362.  
  363.  Do Case
  364.   Case Stat_Msg = 0  && IDLE
  365.    Return(  2 )
  366.    
  367.   Case Stat_Msg = 1  && PAST TOP
  368.    Tone( 100, .1 )
  369.    Return(  2 )
  370.    
  371.   Case Stat_Msg = 2  && PAST END
  372.    Tone( 100, .1 )
  373.    Return(  2 )
  374.  
  375.   Case LASTKEY()=27
  376.    RETURN(0)
  377.  
  378.   CASE LASTKEY()=13
  379.    WINDOWa=MKWINDOW(17,10,21,46)
  380.    IF CTYPE[ELEMENT]=1
  381.     @ 18,16 SAY "This is a 'dominant' name"
  382.     @ 19,17 SAY "for this zip code, no "
  383.     @ 20,17 SAY "alternate is available"
  384.     oldCOLOR=SETCOLOR("B/W")
  385.     CITY_STR=CityAKA(CITY,SUBSTR(ZIPS[ELEMENT],2,5),1)
  386.     @ ROW()+1,26-LEN(CITY_STR)/2 SAY CITY_STR
  387.     SETCOLOR(oldCOLOR)
  388.    ELSE
  389.     CITYCOUNT=1
  390.     DO CASE
  391.      CASE CTYPE[ELEMENT]=2
  392.       @ 18,17 SAY "Abbreviation of dominant"
  393.      CASE CTYPE[ELEMENT]=3
  394.       @ 18,16 SAY "Dominant has abbreviation"
  395.      CASE CTYPE[ELEMENT]=4
  396.       @ 18,15 SAY "Equally interchangeble with"
  397.      CASE CTYPE[ELEMENT]=5
  398.       @ 18,18 SAY "Has dominate alternate"
  399.      CASE CTYPE[ELEMENT]=6
  400.       @ 18,15 SAY "Abbreviation of non-dominant"
  401.       CITYCOUNT=2
  402.      CASE CTYPE[ELEMENT]=7
  403.       @ 18,14 SAY "non-dominant has Abbreviation"
  404.       CITYCOUNT=2
  405.      CASE CTYPE[ELEMENT]=17
  406.       @ 18,15 SAY "Abbreviation OR non-dominant"
  407.      CASE CTYPE[ELEMENT]=32
  408.       @ 18,19 SAY "(Unapproved name)"
  409.       @ 19,18 SAY "Should replace with:"
  410.      OTHERWISE
  411.       @ 18,17 SAY "(UNKNOWN CITY TYPE CODE)"
  412.       CITYCOUNT=0
  413.     ENDCASE
  414.     oldCOLOR=SETCOLOR("B/W")
  415.     DO WHILE CITYCOUNT>0
  416.      CITY_STR=CityAKA(CITY,SUBSTR(ZIPS[ELEMENT],2,5),CITYCOUNT)
  417.      @ ROW()+1,26-LEN(CITY_STR)/2 SAY CITY_STR+IIF(CITYCOUNT=2," (dom)","")
  418.      CITYCOUNT=CITYCOUNT-1
  419.     ENDDO
  420.     SETCOLOR(oldCOLOR)
  421.    ENDIF
  422.    INKEY(0)
  423.    KLWINDOW(WINDOWa)
  424.    RETURN(2)
  425.  
  426.   Case Stat_Msg = 4
  427.    Return(  0 )
  428.    
  429.   Otherwise
  430.    Return( 2 )
  431.       
  432. EndCase
  433.  
  434. ****************************
  435. FUNCTION LOOKUP2
  436.  PARAMETER Stat_Msg, Element, Rel_Pos
  437.  
  438.  Do Case
  439.   Case Stat_Msg = 0  && IDLE
  440.    Return(  2 )
  441.    
  442.   Case Stat_Msg = 1  && PAST TOP
  443.    Tone( 100, .1 )
  444.    Return(  2 )
  445.    
  446.   Case Stat_Msg = 2  && PAST END
  447.    Tone( 100, .1 )
  448.    Return(  2 )
  449.  
  450.   Case LASTKEY()=27
  451.    RETURN(0)
  452.  
  453.   CASE LASTKEY()=13
  454.    WINDOWa=MKWINDOW(17,5,21,31)
  455.    CTYPE_VAL=CityType(SUBSTR(CITIES[ELEMENT],2,28),ZIP)
  456.    DO CASE
  457.     CASE CTYPE_VAL=1
  458.      @ 18,11 SAY "Dominant City"
  459.      @ 19,11 SAY "  Name (1)"
  460.     CASE CTYPE_VAL=2
  461.      @ 18,10 SAY "Abbreviation of"
  462.      @ 19,10 SAY "a Dominant (2)"
  463.     CASE CTYPE_VAL=3
  464.      @ 18,9 SAY " Dominant that has"
  465.      @ 19,9 SAY "an abbreviation (3)"
  466.     CASE CTYPE_VAL=4
  467.      @ 18,9 SAY "City name that has"
  468.      @ 19,9 SAY "equal alternate (4)"
  469.     CASE CTYPE_VAL=5
  470.      @ 18,12 SAY "Non-dominate"
  471.      @ 19,12 SAY "city name (5)"
  472.     CASE CTYPE_VAL=6
  473.      @ 18,10 SAY " Abbreviation of"
  474.      @ 19,10 SAY "a non-dominant (6)"
  475.     CASE CTYPE_VAL=7
  476.      @ 18, 9 SAY "non-dominant that has"
  477.      @ 19,10 SAY " an Abbreviation (7)"
  478.     CASE CTYPE_VAL=17
  479.      @ 18,10 SAY "  Abbreviation or"
  480.      @ 19,10 SAY "a non-dominant (17)"
  481.     OTHERWISE
  482.      @ 18,10 SAY "UNKNOWN CITY TYPE"
  483.      @ 19,10 SAY "   CODE = "+STR(CTYPE_VAL,2,0)
  484.      CITYCOUNT=0
  485.    ENDCASE
  486.    INKEY(0)
  487.    KLWINDOW(WINDOWa)
  488.    RETURN(2)
  489.  
  490.   Case Stat_Msg = 4
  491.    Return(  0 )
  492.    
  493.   Otherwise
  494.    Return( 2 )
  495.       
  496. EndCase
  497.  
  498.  
  499. *!*********************************************************************
  500. *!
  501. *!       Function: FILLSCRN()
  502. *!
  503. *!*********************************************************************
  504. FUNCTION fillscrn
  505. PARAM f_urow,f_ucol,f_lrow,f_lcol,f_char
  506. FOR I=f_urow TO f_lrow
  507.    @ I,f_ucol SAY REPLICATE(f_char,f_lcol-f_ucol+1)
  508. NEXT
  509. RETURN(.T.)
  510.  
  511. *!*********************************************************************
  512. *!
  513. *!       Function: MKWINDOW()
  514. *!
  515. *!*********************************************************************
  516. FUNCTION mkwindow
  517. PARAM w_urow,w_ucol,w_lrow,w_lcol,w_boxtyp,w_title
  518.  
  519. if PCOUNT()<6
  520.    w_title=''
  521. endif
  522.  
  523. if PCOUNT()<5
  524.    w_boxtyp='S'
  525. endif
  526.  
  527. w_retval = savescreen(w_urow,w_ucol,w_lrow+1,w_lcol+2)
  528. w_retval = CHR(w_urow)+CHR(w_ucol)+CHR(w_lrow+1)+CHR(w_lcol+2)+w_retval
  529. windshdw(w_urow+1,w_ucol+2,w_lrow+1,w_lcol+2,iif(iscolor(),1,7))
  530. @ w_urow,w_ucol CLEAR TO w_lrow,w_lcol
  531. if w_boxtyp='D'
  532.    @ w_urow,w_ucol TO w_lrow,w_lcol double
  533. else
  534.    @ w_urow,w_ucol TO w_lrow,w_lcol 
  535. endif
  536. if len(w_title)#0
  537.    w_dchars = '╠═╣'
  538.    w_schars = '├─┤'
  539.    @ w_urow+2,w_ucol say left(w_&w_boxtyp.chars,1)+replicate(substr(w_&w_boxtyp.chars,2,1),w_lcol-w_ucol-1)+right(w_&w_boxtyp.chars,1)
  540.    @ w_urow+1,w_ucol+(w_lcol-w_ucol-len(w_title))/2 say w_title
  541. endif
  542.  
  543. RETURN(w_retval)
  544.  
  545. *!*********************************************************************
  546. *!
  547. *!       Function: KLWINDOW()
  548. *!
  549. *!*********************************************************************
  550. FUNCTION klwindow
  551. PARAM k_str
  552. k_urow = ASC(SUBSTR(k_str,1,1))
  553. k_ucol = ASC(SUBSTR(k_str,2,1))
  554. k_lrow = ASC(SUBSTR(k_str,3,1))
  555. k_lcol = ASC(SUBSTR(k_str,4,1))
  556. k_scrn = SUBSTR(k_str,5)
  557. restscreen(k_urow,k_ucol,k_lrow,k_lcol,k_scrn)
  558. RETURN(.T.)
  559.  
  560.